Keep it in {ggplot2}. Why?
Reinforces learning the ins and outs of one of the strongest dataviz tools in existence
Flexible enough for the needs of the project and your personal style
Good chance of redundancy - many overlapping
Meet exciting new developers learn new ways of analysis & visualization
Sometimes you need a custom package to accomplish the task at hand
Other times, {sf} and {ggplot2} had the solution all along
Jacques Bertin William Bunge Timo Grossenbacher Jacques Bertin William Bunge Timo Grossenbacher Jacques Bertin William Bunge Timo Grossenbacher📎 {ggspatial} can do so much, including easily add a north arrow and scale bar to your map
sea <- places("wa",
cb = TRUE) %>%
filter(NAME == "Seattle") %>%
st_transform(3857) %>%
erase_water(area_threshold = .25)
ggplot() +
geom_sf(data = sea) +
ggspatial::annotation_north_arrow(location = "br",
which_north = "true",
style = north_arrow_minimal) +
annotation_scale(location = "bl",
style = "ticks") +
coord_sf(crs = 3857,
datum = NA) +
theme_minimal() +
theme(panel.border = element_rect(linewidth = .2, fill = NA))📎 Giving your marginalia a little breathing room can be a good move. So expand your limits within coord_sf()!
sea <- places("wa",
cb = TRUE) %>%
filter(NAME == "Seattle") %>%
st_transform(3857) %>%
erase_water(area_threshold = .25)
xlims <- st_buffer(sea, 5000) %>%
st_bbox() %>%
.[c(1, 3)]
ylims <- st_buffer(sea, 5000) %>%
st_bbox() %>%
.[c(2, 4)]
ggplot() +
geom_sf(data = sea) +
ggspatial::annotation_north_arrow(location = "br",
which_north = "true",
style = north_arrow_minimal) +
annotation_scale(location = "bl",
style = "ticks") +
coord_sf(crs = 3857,
datum = NA,
xlim = xlims,
ylim = ylims) +
theme_minimal() +
theme(panel.border = element_rect(linewidth = .2, fill = NA))📎 Kyle Walker’s {mapboxapi} + {ggspatial} = fast, easy basemaps to add context to your map
basemap <- get_static_tiles(
location = st_buffer(sea, 5000),
zoom = 10,
buffer_dist = 0,
scaling_factor = "2x",
crop = TRUE,
style_id = basic_id,
username = me
)
ggplot() +
layer_spatial(data = basemap) +
geom_sf(data = sea,
fill = NA,
color = "peru",
linewidth = 1.5) +
coord_sf(crs = 3857,
datum = NA,
xlim = xlims,
ylim = ylims) +
theme_minimal()📎 Try breaking your basemap into two layers: one for the labels and one for the map itself, using Mapbox studio (or other resource), and then layer them with multiple calls to layer_spatial()
tract_pop <- get_acs("tract",
state = "WA",
county = "King",
variables = "B01001_001",
geometry = TRUE) %>%
st_transform(st_crs(sea)) %>%
st_intersection(sea)
basemap <- get_static_tiles(
location = sea,
zoom = 11,
buffer_dist = 1000,
scaling_factor = "2x",
crop = TRUE,
style_id = basemap_id,
username = me
)
labels <- get_static_tiles(
location = sea,
zoom = 11,
buffer_dist = 1000,
scaling_factor = "2x",
crop = TRUE,
style_id = labels_id,
username = me
)
ggplot() +
layer_spatial(data = basemap) +
geom_sf(data = tract_pop,
aes(fill = estimate),
color = "gray20",
linewidth = .15,
alpha = .7) +
layer_spatial(data = labels) +
scale_fill_viridis_b(option = "A",
direction = 1,
name = "Population",
n.breaks = 7,
labels = comma) +
coord_sf(crs = 3857,
datum = NA) +
theme_minimal() +
theme(plot.background = element_rect(fill = "white", color = "gray20", linewidth = .2))📎 Positioning your legend inside the map can be a good move, especially if you have a lot of white space you’d prefer not to deal with
ggplot() +
layer_spatial(data = basemap) +
geom_sf(data = tract_pop,
aes(fill = estimate),
color = "gray20",
linewidth = .15,
alpha = .7) +
layer_spatial(data = labels) +
scale_fill_viridis_b(option = "A",
direction = 1,
name = "Population",
n.breaks = 7,
labels = comma) +
coord_sf(crs = 3857,
datum = NA,
# This one is necessary!
expand = 0) +
theme_minimal() +
theme(legend.position = "inside",
legend.location = "plot",
legend.position.inside = c(0, 0),
legend.justification.inside = c(0, 0),
# element_rect() doesn't have an alpha argument, but you can trick it with HEX
legend.box.background = element_rect(fill = "#ffffff60", color = NA)) +
theme(plot.background = element_rect(fill = "white", color = "gray20", linewidth = .2))📎 You can use {patchwork} to compose a simple inset map composition. Here you’re really just arranging two separate plots.
greenlake <- st_as_sfc("POLYGON ((-13620987 6050695, -13620987 6056227, -13615566 6056227, -13615566 6050695, -13620987 6050695))", crs = 3857) %>%
st_sf()
xlims <- st_bbox(greenlake)[c(1, 3)]
ylims <- st_bbox(greenlake)[c(2, 4)]
basemap <- get_static_tiles(
location = greenlake,
zoom = 13,
buffer_dist = 1000,
scaling_factor = "2x",
crop = TRUE,
style_id = basemap_id,
username = me
)
labels <- get_static_tiles(
location = greenlake,
zoom = 13,
buffer_dist = 1000,
scaling_factor = "2x",
crop = TRUE,
style_id = labels_id,
username = me
)
inset <- ggplot() +
geom_sf(data = sea,
fill = "white",
color = "gray20",
linewidth = .25) +
geom_sf(data = greenlake,
fill = NA,
color = "tomato",
linewidth = 1.25) +
theme_void() +
coord_sf(datum = NA) +
theme(plot.background = element_rect(fill = "#ffffff60", color = NA))
ggplot() +
layer_spatial(data = basemap) +
geom_sf(data = tract_pop,
aes(fill = estimate),
color = "gray20",
linewidth = .15,
alpha = .7) +
layer_spatial(data = labels) +
scale_fill_viridis_b(option = "A",
direction = 1,
name = "Population",
n.breaks = 7,
labels = comma) +
coord_sf(crs = 3857,
datum = NA,
# This one is necessary!
expand = 0,
xlim = xlims,
ylim = ylims) +
theme_minimal() +
theme(legend.position = "inside",
legend.location = "plot",
legend.position.inside = c(0, 0),
legend.justification.inside = c(0, 0),
# element_rect() doesn't have an alpha argument, but you can trick it with HEX
legend.box.background = element_rect(fill = "#ffffff60", color = NA)) +
patchwork::inset_element(inset,
left = .7,
bottom = 0,
right = 1,
top = .5,
align_to = "full")📎 Or, {ggmagnify} could let you do a more traditional inset, if that’s what you’re looking for
counties <- counties("wa",
cb = TRUE) %>%
st_transform(3857)
to <- st_as_sfc("POLYGON ((-13881692 6185920, -13881692 6376113, -13774182 6376113, -13774182 6185920, -13881692 6185920))",
crs = 3857) %>%
st_sf()
xlims <- st_bbox(st_union(counties, to))[c(1, 3)]
ylims <- st_bbox(st_union(counties, to))[c(2, 4)]
county_map <- ggplot() +
geom_sf(data = counties,
fill = "white",
color = "gray40",
linewidth = .2) +
geom_sf(data = sea,
fill = NA,
color = "tomato",
linewidth = .2) +
coord_sf(crs = 3857,
datum = NA,
# This one is necessary!
expand = 0,
xlim = xlims,
ylim = ylims*c(.9, 1.1)) +
theme_minimal()
county_map +
geom_magnify(data = sea,
from = as.list(st_bbox(sea)[c(1, 3, 2, 4)]),
to = as.list(st_bbox(to)[c(1, 3, 2, 4)])) +
coord_sf(crs = 3857,
datum = NA,
# This one is necessary!
expand = 0,
xlim = xlims,
ylim = ylims*c(.99, 1.01))📎 {ggrepel} is a very powerful tool for labeling your map, especially when you have a lot of labels to place. It can be a bit fussy though, so it will likely take lots of trial and error. And don’t sleep on the bg.colour argument for geom_text_repel()!
cities <- get_acs("place",
state = "wa",
variables = "B01001_001",
year = 2022,
geometry = TRUE) %>%
filter(estimate > 7.5e4) %>%
mutate(NAME = str_remove_all(NAME, paste0(c(" city, Washington", " CDP, Washington"), collapse = "|"))) %>%
mutate(class = santoku::chop(estimate, breaks = c(1e5, 1.5e5, 2e5))) %>%
# filter(NAME %in% c("Seattle", "Tacoma", "Olympia", "Spokane", "Walla Walla")) %>%
st_transform(3857)
ggplot() +
geom_sf(data = counties,
fill = "white",
color = "gray40",
linewidth = .2) +
geom_label_repel(data = st_centroid(cities),
aes(x = st_coordinates(geometry)[, 1],
y = st_coordinates(geometry)[, 2],
label = NAME,
size = class),
min.segment.length = 0,
color = "white",
fill = "tomato3",
label.r = unit(0, "lines"),
label.size = 0,
segment.colour = "tomato3",
segment.size = .5,
nudge_y = 50000) +
geom_sf(data = st_centroid(cities),
color = "tomato3",
fill = "white",
shape = 21,
stroke = 1) +
coord_sf(crs = 3857,
datum = NA,
# This one is necessary!
expand = 0) +
scale_size_discrete(range = c(6, 6, 8, 12),
guide = "none") +
theme_minimal() +
labs(x = NULL,
y = NULL)📎 Using st_inscribed_circle() can help you find the appropriate centroid for unusual polygons, especially when st_point_on_surface() fails
cities <- places("wa") %>%
filter(NAME %in% c("Seattle", "Tacoma", "Olympia", "Spokane", "Walla Walla")) %>%
st_transform(3857)
county_lbls <- st_point_on_surface(counties) %>%
transmute(name = NAME,
x = st_coordinates(.)[, 1],
y = st_coordinates(.)[, 2])
ggplot() +
geom_sf(data = counties,
fill = "white",
color = "gray40",
linewidth = .2) +
geom_text_repel(data = county_lbls,
aes(x = x,
y = y,
label = str_wrap(name, 10)),
# ggrepel functions have this bg.colour argument that is a nice touch for readability
bg.colour = "white",
bg.r = .2,
force = 0,
color = "gray70",
fontface = "bold",
size = 3.5) +
geom_label_repel(data = st_centroid(cities),
aes(x = st_coordinates(geometry)[, 1],
y = st_coordinates(geometry)[, 2],
label = NAME),
min.segment.length = 0,
color = "white",
fill = "tomato3",
label.r = unit(0, "lines"),
label.size = 0,
segment.colour = "tomato3",
segment.size = 1,
nudge_y = 50000) +
geom_sf(data = st_centroid(cities),
color = "tomato3",
fill = "white",
shape = 21,
stroke = 1) +
coord_sf(crs = 3857,
datum = NA,
expand = 0) +
theme_minimal() +
labs(x = NULL,
y = NULL)📎 Using st_inscribed_circle can help you find the appropriate centroid for unusual polygons, especially when st_point_on_surface fails
circles <- counties %>%
pull(geometry) %>%
st_inscribed_circle() %>%
st_sf() %>%
filter(!st_is_empty(geometry))
county_lbls <- circles %>%
st_centroid() %>%
transmute(name = counties$NAME,
x = st_coordinates(.)[, 1],
y = st_coordinates(.)[, 2])
ggplot() +
geom_sf(data = counties,
fill = "white",
color = "gray40",
linewidth = .2) +
geom_sf(data = circles,
fill = NA,
color = "gray20",
linewidth = .25,
linetype = "dotted") +
geom_text_repel(data = county_lbls,
aes(x = x,
y = y,
label = str_wrap(name, 10)),
# ggrepel functions have this bg.colour argument that is a nice touch for readability
bg.colour = "white",
bg.r = .2,
force = 0,
color = "gray70",
fontface = "bold",
size = 3.5) +
geom_label_repel(data = st_centroid(cities),
aes(x = st_coordinates(geometry)[, 1],
y = st_coordinates(geometry)[, 2],
label = NAME),
min.segment.length = 0,
color = "white",
fill = "tomato3",
label.r = unit(0, "lines"),
label.size = 0,
segment.colour = "tomato3",
segment.size = 1,
nudge_y = 50000) +
geom_sf(data = st_centroid(cities),
color = "tomato3",
fill = "white",
shape = 21,
stroke = 1) +
coord_sf(crs = 3857,
datum = NA,
expand = 0) +
theme_minimal() +
labs(x = NULL,
y = NULL)📎 {ggforce} has a geom_mark_...() family of functions that are nicely styled and can be used to label clusters of points or other geometries
# Read in the data, in this case this CSV from WA DNR https://data-wadnr.opendata.arcgis.com/datasets/dabefcb8f03549b49bee7564d4c3c4b5_2/
fires <- read_csv("/Users/sherrill/Projects/CascadiaR_Cartographic_Tips/01_data/01_raw/DNR_Fire_Statistics_2008_-_Present.csv") %>%
st_as_sf(coords = c("LON_COORD", "LAT_COORD"), crs = 4326) %>%
st_transform(3857) %>%
transmute(acres_burned = ACRES_BURNED,
cause = FIREGCAUSE_LABEL_NM,
year = str_sub(DSCVR_DT, 1, 4)) %>%
st_as_sf() %>%
filter(year == 2023,
acres_burned > 0)
fires_ne <- fires %>%
filter(year == 2023,
cause == "Power Gen") %>%
st_filter(counties %>%
filter(NAME %in% c("Pend Oreille", "Spokane", "Stevens"))) %>%
mutate(x = st_coordinates(geometry)[,1],
y = st_coordinates(geometry)[,2])
tot <- sum(fires_ne$acres_burned)
tot_2023 <- sum(fires$acres_burned)
pct <- tot/tot_2023
anchor <- st_centroid(st_union(fires_ne)) %>%
st_sf() %>%
mutate(x = st_coordinates(geometry)[,1],
y = st_coordinates(geometry)[,2])
ggplot() +
geom_sf(data = counties,
fill = "white",
color = "gray40",
linewidth = .2) +
geom_sf(data = fires,
aes(size = acres_burned),
color = "gray50",
alpha = .3) +
geom_sf(data = fires_ne,
aes(size = acres_burned),
color = "peru",
alpha = 1) +
geom_label_repel(data = st_centroid(cities),
aes(x = st_coordinates(geometry)[, 1],
y = st_coordinates(geometry)[, 2],
label = NAME),
min.segment.length = 0,
color = "white",
fill = "tomato3",
label.r = unit(0, "lines"),
label.size = 0,
segment.colour = "tomato3",
segment.size = 1,
nudge_y = 50000) +
geom_sf(data = st_centroid(cities),
color = "tomato3",
fill = "white",
shape = 21,
stroke = 1) +
geom_mark_ellipse(data = fires_ne,
aes(x = x,
y = y,
label = str_wrap(paste0("Wildfires caused by power generation burned a combined ", comma(tot, accuracy = 1), " acres, ", percent(pct, accuracy = 1), " of all statewide acres in 2023, in Pend Oreille, Spokane, and Stevens counties"), 36)),
x0 = anchor$x - 50000,
y0 = anchor$y + 50000,
label.fill = "#E4EBF1",
con.cap = 0,
label.buffer = unit(4, "lines"),
label.fontsize = 10,
show.legend = FALSE) +
scale_size_continuous(name = "Acres\nburned",
range = c(1, 10),
labels = comma,
breaks = c(10, 1000, 5000, 20000, 50000)) +
coord_sf(crs = 3857,
datum = NA,
expand = 0) +
theme_minimal() +
labs(x = NULL,
y = NULL)📎 {ggfx} has a number of graphical filtering functions. You could pair it with {ggforce} to create a poppy label box with a drop-shadow effect
all_fires <- read_csv("/Users/sherrill/Projects/CascadiaR_Cartographic_Tips/01_data/01_raw/DNR_Fire_Statistics_2008_-_Present.csv") %>%
st_as_sf(coords = c("LON_COORD", "LAT_COORD"), crs = 4326) %>%
st_transform(3857) %>%
transmute(acres_burned = ACRES_BURNED,
cause = FIREGCAUSE_LABEL_NM,
year = str_sub(DSCVR_DT, 1, 4)) %>%
st_as_sf()
fires <- all_fires %>%
filter(year == 2023,
acres_burned > 0)
fires_ne <- fires %>%
filter(year == 2023,
cause == "Power Gen") %>%
st_filter(counties %>%
filter(NAME %in% c("Pend Oreille", "Spokane", "Stevens"))) %>%
mutate(x = st_coordinates(geometry)[,1],
y = st_coordinates(geometry)[,2])
tot <- sum(fires_ne$acres_burned)
tot_2023 <- sum(fires$acres_burned)
pct <- tot/tot_2023
anchor <- st_centroid(st_union(fires_ne)) %>%
st_sf() %>%
mutate(x = st_coordinates(geometry)[,1],
y = st_coordinates(geometry)[,2])
ggplot() +
geom_sf(
data = counties,
fill = "white",
color = "gray40",
linewidth = .2
) +
geom_sf(
data = fires,
aes(size = acres_burned),
color = "gray50",
alpha = .3
) +
geom_sf(
data = fires_ne,
aes(size = acres_burned),
color = "peru",
alpha = 1
) +
geom_label_repel(
data = st_centroid(cities),
aes(
x = st_coordinates(geometry)[, 1],
y = st_coordinates(geometry)[, 2],
label = NAME
),
min.segment.length = 0,
color = "white",
fill = "tomato3",
label.r = unit(0, "lines"),
label.size = 0,
segment.colour = "tomato3",
segment.size = 1,
nudge_y = 50000
) +
geom_sf(
data = st_centroid(cities),
color = "tomato3",
fill = "white",
shape = 21,
stroke = 1
) +
with_shadow(
geom_mark_ellipse(
data = fires_ne,
aes(
x = x,
y = y,
label = str_wrap(
paste0(
"Wildfires caused by power generation burned a combined ",
comma(tot, accuracy = 1),
" acres, ",
percent(pct, accuracy = 1),
" of all statewide acres in 2023, in Pend Oreille, Spokane, and Stevens counties"
),
36
)
),
x0 = anchor$x - 50000,
y0 = anchor$y + 50000,
label.fill = "#E4EBF1",
con.cap = 0,
label.buffer = unit(4, "lines"),
label.fontsize = 10,
show.legend = FALSE
),
colour = "#151F2850",
sigma = 3
) +
scale_size_continuous(
name = "Acres\nburned",
range = c(1, 10),
labels = comma,
breaks = c(10, 1000, 5000, 20000, 50000)
) +
coord_sf(crs = 3857,
datum = NA,
expand = 0) +
theme_minimal() +
labs(x = NULL, y = NULL)📎 {ggdensity} has a geom_hdr() functions that provides a more visually appealing way to show point density, with a fairly easy-to-understand legend. You could even give it a blur with {ggfx} to make it seem more gestural than literal
fires_hdr <- fires %>%
mutate(x = st_coordinates(geometry)[,1],
y = st_coordinates(geometry)[,2]) %>%
st_drop_geometry() %>%
filter(cause %in% c("Natural", "Power Gen", "Fireworks")) %>%
mutate(cause = ordered(cause,
levels = c("Natural", "Power Gen", "Fireworks")))
ggplot() +
as_reference(with_blur(
geom_hdr(
data = fires_hdr,
aes(
x = x,
y = y,
group = cause,
fill = cause
),
probs = c(.33),
n = 300,
# Expand the limits to give the geometry some breathing room
xlim = st_bbox(counties)[c(1, 3)] * c(.9, 1.1),
ylim = st_bbox(counties)[c(2, 4)] * c(.9, 1.1),
alpha = .8
),
sigma = unit(.25, "lines")
), id = "hdr") +
# Putting a xor blend on our county borders could help them not get lost behind the HDR
with_blend(
geom_sf(
data = counties,
fill = "NA",
color = "gray20",
linewidth = .2
),
bg_layer = "hdr",
blend_type = "xor"
) +
geom_label_repel(
data = st_centroid(cities),
aes(
x = st_coordinates(geometry)[, 1],
y = st_coordinates(geometry)[, 2],
label = NAME
),
min.segment.length = 0,
color = "white",
fill = "tomato3",
label.r = unit(0, "lines"),
label.size = 0,
segment.colour = "tomato3",
segment.size = 1,
nudge_y = 50000
) +
geom_sf(
data = st_centroid(cities),
color = "tomato3",
fill = "white",
shape = 21,
stroke = 1
) +
scale_fill_manual(name = "Cause",
values = c("deepskyblue4", "deeppink4", "peru")) +
coord_sf(crs = 3857,
datum = NA,
expand = 0) +
theme_minimal(base_size = 12) +
theme(legend.position = "top",
legend.justification.top = "left") +
labs(x = NULL, y = NULL)📎 Then again, sometimes using a grid is an effective way of showing spatial patterns, and you can add an extra visual variable by using points that match your grid and varying their size
wa_grid <- st_make_grid(counties,
cellsize = 20000) %>%
st_sf() %>%
rowid_to_column("gridid")
fire_grid <- st_join(wa_grid, all_fires %>%
filter(acres_burned > 0,
cause %in% c("Power Gen", "Fireworks", "Natural"))) %>%
group_by(gridid, cause) %>%
summarise(acres_burned = sum(acres_burned)) %>%
group_by(gridid) %>%
filter(acres_burned == max(acres_burned, na.rm = TRUE)) %>%
ungroup() %>%
mutate(acres_burned = ifelse(is.na(acres_burned), 0, acres_burned)) %>%
st_centroid() %>%
mutate(cause = ordered(cause,
levels = c("Natural", "Power Gen", "Fireworks")))
ggplot() +
geom_sf(
data = counties,
fill = "white",
color = "gray40",
linewidth = .2
) +
geom_sf(data = fire_grid,
aes(color = cause, size = acres_burned),
shape = 15) +
geom_label_repel(
data = st_centroid(cities),
aes(
x = st_coordinates(geometry)[, 1],
y = st_coordinates(geometry)[, 2],
label = NAME
),
min.segment.length = 0,
color = "white",
fill = "tomato3",
label.r = unit(0, "lines"),
label.size = 0,
segment.colour = "tomato3",
segment.size = 1,
nudge_y = 50000
) +
geom_sf(
data = st_centroid(cities),
color = "tomato3",
fill = "white",
shape = 21,
stroke = 1
) +
scale_size_binned(
name = "Acres\nburned",
labels = comma,
range = c(2, 5),
breaks = c(10, 25000),
guide = guide_bins(keywidth = unit(2, "lines"))
) +
scale_color_manual(name = "Cause",
values = c("deepskyblue4", "deeppink4", "peru")) +
coord_sf(crs = 3857,
datum = NA,
expand = 0) +
theme_minimal(base_size = 12) +
theme(legend.position = "top",
legend.justification.top = "left") +
labs(
x = NULL,
y = NULL
)📎 Though you might want to make your other layers conform to this grid, too.
wa_grid <- st_make_grid(counties,
cellsize = 20000) %>%
st_sf() %>%
rowid_to_column("gridid")
county_grid <- wa_grid %>%
st_join(counties, largest = TRUE, left = FALSE) %>%
group_by(county = NAME) %>%
summarise()
county_grid_lbls <- county_grid %>%
pull(geometry) %>%
st_inscribed_circle() %>%
st_sf() %>%
filter(!st_is_empty(geometry)) %>%
st_centroid() %>%
transmute(name = county_grid$county,
x = st_coordinates(.)[, 1],
y = st_coordinates(.)[, 2])
fire_grid <- st_join(wa_grid, all_fires %>%
filter(acres_burned > 0,
cause %in% c("Power Gen", "Fireworks", "Natural"))) %>%
group_by(gridid, cause) %>%
summarise(acres_burned = sum(acres_burned)) %>%
group_by(gridid) %>%
filter(acres_burned == max(acres_burned, na.rm = TRUE)) %>%
ungroup() %>%
mutate(acres_burned = ifelse(is.na(acres_burned), 0, acres_burned)) %>%
st_centroid() %>%
mutate(cause = ordered(cause,
levels = c("Natural", "Power Gen", "Fireworks")))
ggplot() +
geom_sf(
data = county_grid,
fill = "white",
color = "gray40",
linewidth = .33
) +
geom_sf(data = fire_grid,
aes(color = cause,
size = acres_burned),
shape = 15) +
geom_label(data = county_lbls,
aes(x = x,
y = y,
label = str_wrap(name, 4)),
fill = "gray90",
alpha = .7,
color = "gray20",
fontface = "bold",
label.r = unit(0, "lines"),
label.size = 0,
size = 3.5) +
scale_size_binned(name = "Acres\nburned",
labels = comma,
range = c(2, 5),
breaks = c(10, 25000),
guide = guide_bins(keywidth = unit(2, "lines"))) +
scale_color_manual(name = "Cause",
values = c("deepskyblue4", "deeppink4", "peru")) +
coord_sf(crs = 3857,
datum = NA,
expand = 0) +
theme_minimal(base_size = 12) +
theme(legend.position = "top",
legend.justification.top = "left") +
labs(x = NULL, y = NULL)📎 While we’re modifying geometries, {rmapshaper} is a great package for simplifying geometries, which can be especially useful for rendering large spatial datasets
counties_simp <- ms_simplify(counties, keep = .02, keep_shapes = TRUE)
counties_simp_lbls <- counties_simp %>%
pull(geometry) %>%
st_inscribed_circle() %>%
st_sf() %>%
filter(!st_is_empty(geometry)) %>%
st_centroid() %>%
transmute(name = counties_simp$NAME,
x = st_coordinates(.)[, 1],
y = st_coordinates(.)[, 2])
ggplot() +
geom_sf(
data = counties_simp,
fill = "white",
color = "gray40",
linewidth = .2
) +
geom_sf(data = fire_grid,
aes(color = cause, size = acres_burned),
shape = 15) +
geom_label(
data = counties_simp_lbls,
aes(
x = x,
y = y,
label = str_wrap(name, 4)
),
fill = "gray90",
alpha = .7,
color = "gray20",
fontface = "bold",
label.r = unit(0, "lines"),
label.size = 0,
size = 3.5
) +
scale_size_binned(
name = "Acres\nburned",
labels = comma,
range = c(2, 5),
breaks = c(10, 25000),
guide = guide_bins(keywidth = unit(2, "lines"))
) +
scale_color_manual(name = "Cause",
values = c("deepskyblue4", "deeppink4", "peru")) +
coord_sf(crs = 3857,
datum = NA,
expand = 0) +
theme_minimal(base_size = 12) +
theme(legend.position = "top",
legend.justification.top = "left") +
labs(x = NULL, y = NULL)📎 {smoothr} can also be used to add rounded corners to your polygons or line geometries for a more stylized look
counties_simp <- counties %>%
ms_simplify(keep = .02, keep_shapes = TRUE) %>%
smooth(method = "ksmooth",
smoothness = .35) %>%
# Sometimes you can create geometry errors when smoothing, so it's good to check and fix these with a call to st_make_valid()
st_make_valid()
counties_simp_lbls <- counties_simp %>%
pull(geometry) %>%
st_inscribed_circle() %>%
st_sf() %>%
filter(!st_is_empty(geometry)) %>%
st_centroid() %>%
transmute(name = counties_simp$NAME,
x = st_coordinates(.)[, 1],
y = st_coordinates(.)[, 2])
ggplot() +
geom_sf(
data = counties_simp,
fill = "white",
color = "gray40",
linewidth = .2
) +
geom_sf(data = fire_grid,
aes(color = cause, size = acres_burned),
shape = 16) +
geom_label(
data = counties_simp_lbls,
aes(
x = x,
y = y,
label = str_wrap(name, 4)
),
fill = "gray90",
alpha = .7,
color = "gray20",
fontface = "bold",
label.r = unit(0, "lines"),
label.size = 0,
size = 3.5
) +
scale_size_binned(
name = "Acres\nburned",
labels = comma,
range = c(2, 5),
breaks = c(10, 25000),
guide = guide_bins(keywidth = unit(2, "lines"))
) +
scale_color_manual(name = "Cause",
values = c("deepskyblue4", "deeppink4", "peru")) +
coord_sf(crs = 3857,
datum = NA,
expand = 0) +
theme_minimal(base_size = 12) +
theme(legend.position = "top",
legend.justification.top = "left") +
labs(x = NULL, y = NULL)📎 Did you know you can use negative values for st_buffer()?
counties_simp <- counties %>%
st_buffer(-2000) %>%
ms_simplify(keep = .02, keep_shapes = TRUE) %>%
smooth(method = "ksmooth", smoothness = .35) %>%
# Sometimes you can create geometry errors when smoothing, so it's good to check and fix these with a call to st_make_valid()
st_make_valid()
counties_simp_lbls <- counties_simp %>%
pull(geometry) %>%
st_inscribed_circle() %>%
st_sf() %>%
filter(!st_is_empty(geometry)) %>%
st_centroid() %>%
transmute(name = counties_simp$NAME,
x = st_coordinates(.)[, 1],
y = st_coordinates(.)[, 2])
ggplot() +
geom_sf(
data = counties_simp,
fill = "white",
color = "gray20",
linewidth = .2
) +
geom_sf(
data = fire_grid %>%
st_filter(counties_simp),
aes(color = cause, size = acres_burned),
shape = 16
) +
geom_label(
data = counties_simp_lbls,
aes(
x = x,
y = y,
label = str_wrap(name, 4)
),
fill = "gray90",
alpha = .7,
color = "gray20",
fontface = "bold",
label.r = unit(0, "lines"),
label.size = 0,
size = 3.5
) +
scale_size_binned(
name = "Acres\nburned",
labels = comma,
range = c(2, 5),
breaks = c(10, 25000),
guide = guide_bins(keywidth = unit(2, "lines"))
) +
scale_color_manual(name = "Cause",
values = c("deepskyblue4", "deeppink4", "peru")) +
coord_sf(crs = 3857,
datum = NA,
expand = 0) +
theme_minimal(base_size = 12) +
theme(legend.position = "top",
legend.justification.top = "left") +
labs(x = NULL, y = NULL)📎 Brand new package {ggarrow} offers a completely new way of visualizing flowlines from point to point with arrows that aren’t the lackluster defaults from {ggplot2}. Lots of customizability!
lines <- st_as_sfc(c("LINESTRING (-122.3207 47.52453, -122.418 47.23233)", "LINESTRING (-122.3298 47.56603, -122.8504 47.03125)",
"LINESTRING (-122.2829 47.54782, -122.5151 45.6868)", "LINESTRING (-122.1708 47.5856, -117.4509 47.67072)",
"LINESTRING (-122.2388 47.55275, -119.3356 46.312)", "LINESTRING (-122.3922 45.71895, -119.4382 46.20556)",
"LINESTRING (-117.3921 47.49202, -119.2271 46.29595)"),
crs = 4326) %>%
st_transform(3857) %>%
st_sf() %>%
rowid_to_column("lineid") %>%
st_cast("POINT") %>%
mutate(x = st_coordinates(.)[,1],
y = st_coordinates(.)[,2]) %>%
st_drop_geometry() %>%
group_by(lineid) %>%
mutate(pt = 1:2) %>%
pivot_wider(names_from = pt,
values_from = c(x, y))
ggplot() +
geom_sf(
data = counties_simp,
fill = "white",
color = "gray40",
linewidth = .2
) +
geom_arrow_curve(
data = lines,
aes(
x = x_1,
y = y_1,
xend = x_2,
yend = y_2,
group = lineid
),
color = "deepskyblue4",
curvature = .2,
arrow_head = arrow_head_wings(offset = 50),
length = 2,
length_head = 1,
linewidth_head = 6,
linewidth_fins = 0,
alpha = .3
) +
scale_size_binned(
name = "Acres\nburned",
labels = comma,
range = c(2, 5),
breaks = c(10, 25000),
guide = guide_bins(keywidth = unit(2, "lines"))
) +
scale_color_manual(name = "Cause",
values = c("deepskyblue4", "deeppink4", "peru")) +
coord_sf(crs = 3857,
datum = NA,
expand = 0) +
theme_minimal(base_size = 12) +
theme(legend.position = "top",
legend.justification.top = "left") +
labs(x = NULL, y = NULL)📎 {ggstar} doesn’t get enough love! It’s a great way to show point data with a little more flair than the standard {ggplot2} PCH shapes
star_fire_grid <- st_join(wa_grid, all_fires %>%
filter(acres_burned > 0,
year >= 2003,
cause %in% c("Power Gen", "Fireworks", "Natural"),
!is.na(cause)),
left = FALSE) %>%
st_drop_geometry() %>%
group_by(gridid, year, cause) %>%
summarise(acres_burned = sum(acres_burned)) %>%
ungroup() %>%
complete(year, cause, nesting(gridid), fill = list(acres_burned = 0)) %>%
filter(!is.na(cause)) %>%
group_by(gridid, cause) %>%
mutate(cause_acres = sum(acres_burned)) %>%
group_by(gridid) %>%
mutate(main_cause = first(cause[which(cause_acres == max(cause_acres))])) %>%
group_by(gridid, main_cause, year) %>%
summarise(acres_burned = ifelse(is.na(acres_burned), 0, acres_burned)) %>%
group_by(gridid, main_cause) %>%
summarise(year = weighted.mean(as.numeric(year), w = acres_burned, na.rm = TRUE),
acres_burned = sum(acres_burned)) %>%
ungroup() %>%
inner_join(wa_grid) %>%
st_as_sf() %>%
st_centroid() %>%
mutate(main_cause = ordered(main_cause,
levels = c("Natural", "Power Gen", "Fireworks")),
x = st_coordinates(.)[, 1],
y = st_coordinates(.)[, 2]) %>%
st_drop_geometry()
ggplot() +
geom_sf(
data = county_grid,
fill = "white",
color = "gray40",
linewidth = .2
) +
geom_star(
data = star_fire_grid,
aes(
fill = year,
size = acres_burned,
starshape = main_cause,
x = x,
y = y
),
starstroke = .1
) +
geom_label(
data = county_lbls,
aes(
x = x,
y = y,
label = str_wrap(name, 4)
),
fill = "gray90",
alpha = .7,
color = "gray20",
fontface = "bold",
label.r = unit(0, "lines"),
label.size = 0,
size = 3.5
) +
scale_size_binned(
name = "Acres\nburned",
labels = comma,
range = c(2, 5),
breaks = c(10, 25000),
guide = guide_bins(keywidth = unit(2, "lines"),
override.aes = list(starshape = 3))
) +
scale_starshape_manual(
name = "Cause",
values = c(
"Natural" = 28,
"Power Gen" = 30,
"Fireworks" = 3
),
guide = guide_legend(override.aes = list(size = 5))) +
scale_fill_distiller(name = "Wtd. Avg. Year",
palette = "Oranges",
direction = 1) +
coord_sf(crs = 3857,
datum = NA,
expand = 0) +
theme_minimal(base_size = 12) +
theme(legend.position = "right") +
labs(x = NULL, y = NULL)📎 {ggsvg} give you the ability to use SVGs as points in your plots, even our old pal Clippy!
# Read in a downloaded static SVG
svg_text <- paste(readLines("./01_data/01_raw/clippy.svg"), collapse = "\n")
ggplot() +
geom_sf(
data = counties,
fill = "white",
color = "gray40",
linewidth = .2
) +
geom_point_svg(
data = clippy[1,],
aes(x = x, y = y),
size = 5,
svg = svg_text,
svg_width = 600,
svg_height = 800,
defaults = list(fill_inner = 'white', fill_outer = 'red')
) +
geom_label_repel(
data = clippy[1,],
aes(
x = x,
y = y,
label = str_wrap(lines, 24)
),
size = 5,
hjust = 0,
nudge_x = 50000,
nudge_y = 50000,
min.segment.length = 0,
point.padding = unit(2, "lines")
) +
scale_size_continuous(
name = "Acres\nburned",
range = c(1, 10),
labels = comma,
breaks = c(1, 5, 50, 100, 1000)
) +
coord_sf(crs = 3857,
datum = NA,
expand = 0) +
theme_minimal() +
labs(x = NULL, y = NULL)@hadley, @thomasp85 {gg______}, @edzer {sf}, @clauswilke {ggplot2 and others}, @paleolimbot {ggspatial}, @ateucher {rmapshaper}, @coolbutuseless {ggsvg}, @slokow {ggrepel}, @walkerke {tidycensus}, @jamesotto852 {ggdensity}, @xiangpin {ggstar}, @hughjonesd {ggmagnify}, @mstrimas {smoothr}
and many more!